package gri_secmgr;

use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);

use Exporter;
$VERSION = 1.00;
@ISA = qw(Exporter);

@EXPORT_OK = qw( 	got_cookie 
			set_cookie
			send_cookie
			redirect_header
			show_login
			modify_input
			remove_sections
			change_keywords
			get_cookie_value
			get_user_name
			valid_user_access );

my %COOKIE_MONSTER=();

use CGI;
use CGI::Cookie;
use CGI::Carp;

{
my %cookie_cache;

sub set_cookie {
my %args=@_;
my $cookie;

	if(exists($args{expires})) {
		$cookie=new CGI::Cookie(
				-expires=> $args{expires},
				-name	=> $args{name},
				-value	=> $args{value},
				-path	=> "/");
	} else {
		$cookie=new CGI::Cookie(
				-name	=> $args{name},
				-value	=> $args{value},
				-path	=> "/");
	}
	$cookie_cache{$args{name}}=$args{value};
	return $cookie;
}


sub send_cookie {
my %args=@_;

	print "Set-Cookie: ",$args{cookie},"\n";
}

sub got_cookie {
my %args=@_;
my $v;
my $query;

	if(exists($cookie_cache{$args{name}})) {
		return 1;
	}
	$query = new CGI;
	%COOKIE_MONSTER = fetch CGI::Cookie;
	if(! exists $COOKIE_MONSTER{$args{name}}) {
		return 0;
	}
	$v=$COOKIE_MONSTER{$args{name}}->value;

	if(!defined $v) {
		return 0;
	}
	return 1;
}

sub get_cookie_value {
my %args=@_;
my $v;

	if(exists($cookie_cache{$args{name}})) {
		return $cookie_cache{$args{name}};
	}
	if(! exists $COOKIE_MONSTER{$args{name}}) {
		return undef;
	}
	$v=$COOKIE_MONSTER{$args{name}}->value;

	if(!defined $v) {
		return undef;
	}
	return $v;
}

}

sub show_login {
my %args=@_;

	my $t=$::GRI_FRONTEND->get_template_directory();
	if(! -f "$t/login.html") {
		print "<p>No login page available!</p>\n";
	} else {
		open FD,"$t/login.html";
		@lines=<FD>;
		close FD;

		#########################################################
		# We scan the lines looking for section __START_error	#
		# and ending with __END_error. If no error defined	#
		# this section is removed, otherwise the lines are	#
		# removed and the output between them is included.	#
		# 							#
		# If the lines include an __error__ setting it will be	#
		# replaced with the error text.				#
		#########################################################

		if(exists $args{error}) {
			@lines=modify_input("error",$args{error},\@lines);
		}
		if(exists($ENV{"QUERY_STRING"}) && $ENV{"QUERY_STRING"} =~ /debug/) {
			@lines=modify_input("debug","",\@lines);
		}
		if(exists($ENV{"QUERY_STRING"}) && $ENV{"QUERY_STRING"} =~ /eoccnet/) {
			@lines=modify_input("eoccnet","",\@lines);
		}
		@lines=remove_sections(\@lines);
		print @lines;
	}
}

sub modify_input {
my $section=shift;
my $value=shift;
my $lref=shift;

my $insection=0;
my @nl=();

	for (@$lref) {
		if(/^__START_$section$/) {
			$insection=1;
			next;
		}
		if($insection && /^__END_$section$/) {
			$insection=0;
			next;
		}
		if(! $insection) {
			push @nl,$_;
		} else {
			if(/__$section__/) {
				my $x;

				$x=$_;
				$x =~ s/__${section}__/$value/;
				push @nl,$x;
			} else {
				push @nl,$_;
			}
		}
	}
	return @nl;
}

sub remove_sections {
my $lref=shift;

my $insection=0;
my @nl=();

	for (@$lref) {
		if(/^__START_[a-z]*$/) {
			$insection=1;
			next;
		}
		if($insection && /^__END_[a-z]*$/) {
			$insection=0;
			next;
		}
		if(! $insection) {
			push @nl,$_;
		}
	}
	return @nl;
}

sub swap_text {
my $search_text=shift;
my $replace_text=shift;
my $lref=shift;

my @nl=();

	for (@$lref) {
		if(/$search_text/) {
			$_ =~ s/$search_text/$replace_text/;
		}
		push @nl,$_;
	}
	return @nl;
}

sub change_keywords {
my $href=shift;
my $lref=shift;
my $cline;
my $key;
my @nl=();

	for $cline (@$lref) {
		for $key (keys %$href) {
			if($cline =~ /#__${key}__#/) {
				my $v=$href->{$key};
				$cline =~ s/#__${key}__#/$v/g;
			}
		}
		push @nl,$cline;
	}
	return @nl;
}

sub redirect_header {
my %args=@_;

	print "Location: ",$args{path},"\n\n";
}

sub get_user_name() {
	my $user_stuff=get_cookie_value(name=>"gri_dbm_intranet");
	return(undef) if !defined($user_stuff);
	my @F=split(/\s+/,$user_stuff);
	my $user_name=$F[0];
	return $user_name;
}

sub valid_user_access($$) {
my $users_dir=shift;
my $role=shift;

	if(!defined($users_dir)) {
		return "ERROR: Global 'users' directory not defined.";
	}

	my $user_stuff=get_cookie_value(name=>"gri_dbm_intranet");
	my @F=split(/\s+/,$user_stuff);
	my $user_name=$F[0];
	my $roles="";
	if(-r "$users_dir/$user_name" && -f _) {
		my $fd;
		open($fd,"$users_dir/$user_name"); 
		$roles=<$fd>; close($fd);
		chomp $roles;
	}
	my @R=split(/,/,$roles);
	my $portal_admin=0;
	if(grep {$_ eq $role} @R) {
		return "OK";
	}
	print STDERR "ERROR: User '$user_name' does not have access to role '$role'.\n";
	return "ERROR: User '$user_name' does not have access to role '$role'.";
}

1;


